home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / buttons.tcl.z / buttons.tcl
Text File  |  2002-07-08  |  7KB  |  244 lines
  1. # buttons.tcl
  2. #
  3. # Action buttons for EXMH.  These are divided into three sets:
  4. # Main - global things like Help and Quit
  5. # Folder - operations on folders like Pack, or Inc.
  6. # Message - operations on the current message.
  7. #
  8. # Support routines for buttons (and menus) in exmh.  The main abstraction
  9. # is the notion of sets of buttons that are enabled and disabled to
  10. # reflect different modes in exmh.  For example, some buttons (and menu
  11. # entries) are disabled when there is no current message.
  12. #
  13. # Copyright (c) 1993 Xerox Corporation.
  14. # Use and copying of this software and preparation of derivative works based
  15. # upon this software are permitted. Any distribution of this software or
  16. # derivative works must comply with all applicable United States export
  17. # control laws. This software is made available AS IS, and Xerox Corporation
  18. # makes no warranty about the software, its performance or its conformity to
  19. # any specification.
  20.  
  21. proc Buttons_Init {} {
  22.     global buttons
  23.     set buttons(draftMode) 0
  24.     set buttons(group,current) {}
  25.     set buttons(group,nodraft) {}
  26.     set buttons(group,range) {}
  27.     set buttons(group,comp) {}
  28.     set buttons(groupMenu,current) {}
  29.     set buttons(groupMenu,nodraft) {}
  30.     set buttons(groupMenu,range) {}
  31.     set buttons(groupMenu,comp) {}
  32. }
  33. proc Buttons_Group { frame name buts } {
  34.     global buttons
  35.     foreach but $buts {
  36.     lappend buttons(group,$name) $frame.$but
  37.     }
  38.     if {$name == "comp"} {
  39.     # TODO - eliminate this comp special case and add a comp -use button
  40.     set w [lindex $buts 0]
  41.     if {$w != {}} {
  42.         set buttons(comp) $frame.$w
  43.     }
  44.     }
  45. }
  46.  
  47. proc Buttons_GroupMenu { menu name labels } {
  48.     global buttons
  49.     foreach l $labels {
  50.     lappend buttons(groupMenu,$name) [list $menu $l]
  51.     }
  52. }
  53.  
  54. proc ButtonsGroupState { group state } {
  55.     global buttons
  56.     foreach button $buttons(group,$group) {
  57.     if [catch {$button configure -state $state} err] {
  58.         Exmh_Status $err error
  59.     }
  60.     }
  61.     foreach item $buttons(groupMenu,$group) {
  62.     set menu [lindex $item 0]
  63.     set label [lindex $item 1]
  64.     if [catch {$menu entryconfigure $label -state $state} err] {
  65.         # The group stuff is not menu-specific, so adding another
  66.         # menu results in error messages from this point.
  67.         # Exmh_Status $err error
  68.     }
  69.     }
  70. }
  71.  
  72. proc Buttons_Current { curMsg } {
  73.     # if curMsg is false, then disable inappropriate buttons
  74.     # otherwise, reenable them.
  75.     # This gets called before Buttons_DraftMode when entering
  76.     # the drafts folder (i.e., buttons(draftMode) may be wrong)
  77.     global buttons
  78.     set buttons(curMsg) $curMsg
  79.     if {$curMsg} {
  80.     ButtonsGroupState current normal
  81.     Buttons_Range $curMsg
  82.     if $buttons(draftMode) {
  83.         ButtonsGroupState nodraft disabled
  84.         ButtonsGroupState comp normal
  85.     }
  86.     } else {
  87.     ButtonsGroupState current disabled
  88.     if $buttons(draftMode) {
  89.         ButtonsGroupState comp disabled
  90.     }
  91.     }
  92. }
  93.  
  94. proc Buttons_DraftMode { inDraftMode } {
  95.     # This procedure is called when entering the drafts folder
  96.     # in order to dink the buttons so you can edit and send
  97.     # a message in the drafts folder.  The inDraftMode
  98.     # parameter is true when entering the drafts folder,
  99.     # and it is false when leaving it.
  100.     global buttons
  101.     set buttons(draftMode) $inDraftMode
  102.     if {$inDraftMode} {
  103.     # Disable inappropriate buttons
  104.     ButtonsGroupState nodraft disabled
  105.     ButtonsGroupState comp normal
  106.     # Override the Send button
  107.     if [info exists buttons(comp)] {
  108.         if [catch {
  109.         set buttons(comp,label) [lindex [$buttons(comp) configure -text] 4]
  110.         set buttons(comp,cmd) [lindex [$buttons(comp) configure -command] 4]
  111.         $buttons(comp) configure -text EDIT -command Edit_Draft
  112.         if {! $buttons(curMsg)} {
  113.             $buttons(comp) configure -state disabled
  114.         }
  115.         } err] {
  116.         Exmh_Status $err error
  117.         }
  118.     }
  119.     } else {
  120.     # Reenable buttons
  121.     ButtonsGroupState nodraft normal
  122.     ButtonsGroupState comp normal
  123.     # Restore Send button
  124.     if {[info exists buttons(comp,cmd)] && \
  125.         [info exists buttons(comp,label)]} { 
  126.         $buttons(comp) configure -command $buttons(comp,cmd) \
  127.             -text $buttons(comp,label) -state normal
  128.         unset buttons(comp,cmd)
  129.         unset buttons(comp,label)
  130.     }
  131.     }
  132.     return
  133. }
  134.  
  135. proc Buttons_Range { {ok 1} } {
  136.     if {$ok} {
  137.     ButtonsGroupState range normal
  138.     } else {
  139.     ButtonsGroupState range disabled
  140.     }
  141. }
  142.  
  143. #####################################################################
  144.  
  145. proc Buttons_Main { frame } {
  146.     # Note that the unused space in $frame is used
  147.     # by Exmh_MainLabel to hold the version string
  148.     global buttons
  149.     set buttons(mainF) $frame
  150.  
  151.     foreach b [Widget_GetButDef $frame] {
  152.     Widget_AddButDef $frame $b
  153.     }
  154.     foreach M [Widget_GetMenuBDef $frame] {
  155.     set menu [Widget_AddMenuBDef $frame $M {right padx 1 filly}]
  156.     ButtonMenuInner $menu
  157.     }
  158. }
  159.  
  160. proc Buttons_Folder { frame } {
  161.     # Create the buttons for operations on items in MH folders
  162.     # Note that the unsed space in $frame is used by
  163.     # Folder_Label to display the status of the current folder.
  164.     global buttons inc
  165.     set buttons(folderF) $frame
  166.  
  167.     # Menu for extra stuff
  168.     foreach M [Widget_GetMenuBDef $frame] {
  169.     set menu [Widget_AddMenuBDef $frame $M {right padx 1 filly}]
  170.     ButtonMenuInner $menu
  171.     }
  172.  
  173.     foreach b [Widget_GetButDef $frame] {
  174.     if {$inc(style) == "none" && $b == "inc"} continue
  175.     Widget_AddButDef $frame $b
  176.     }
  177. }
  178.  
  179. proc Buttons_Message { frame } {
  180.     global buttons
  181.     set buttons(msgF) $frame
  182.  
  183.     # Menu for extra stuff
  184.     # Loop through system and user-defined menus
  185.     foreach M [Widget_GetMenuBDef $frame] {
  186.     set menu [Widget_AddMenuBDef $frame $M {right padx 1 filly}]
  187.     ButtonMenuInner $menu
  188.  
  189.     # but only deal with system-defined groups
  190.     foreach g [Widget_GetGroupDef $frame] {
  191.         Buttons_GroupMenu $menu $g [Widget_GetMenuGrDef $frame $g]
  192.     }
  193.     }
  194.  
  195.     foreach b [Widget_GetButDef $frame] {
  196.     Widget_AddButDef $frame $b
  197.     }
  198.  
  199.     # The group assignments associate buttons with states.
  200.  
  201.     foreach g [Widget_GetGroupDef $frame] {
  202.     Buttons_Group $frame $g [Widget_GetButGrDef $frame $g]
  203.     }
  204. }
  205. proc ident { args } {
  206.     concat $args
  207. }
  208. # Ugh! - macro expand the variable name in
  209. # the context of the (original) caller of ButtonMenuInner
  210. # Allows variable references in the app-defaults file
  211. # The split-join trick is basically a no-op that gives the
  212. # TCL interpreter a chance to do variable expansion.  The
  213. # list and protected brackets are required to defend against
  214. # command strings ($c values) that contain semi-colons
  215. proc ButtonMenuInner { menu {level 1} } {
  216.     global pgp
  217.  
  218.     foreach e [Widget_GetEntryDef $menu] {
  219.     set l [option get $menu l_$e {}]
  220.         if {$pgp(enabled) || ![string match "*PGP*" $l]} {
  221.         set c [option get $menu c_$e {}]
  222.         set v [option get $menu v_$e {}]
  223.         set x [option get $menu x_$e {}]
  224.         set v [uplevel $level [list subst $v]]     ;# was ident
  225.         set c [uplevel $level [list subst $c]]
  226.         Exmh_Debug \"$l\" $c
  227.         case [option get $menu t_$e {}] {
  228.         default {Widget_AddMenuItem $menu $l $c}
  229.         check   {Widget_CheckMenuItem $menu $l $c $v}
  230.         radio   {Widget_RadioMenuItem $menu $l $c $v $x}
  231.         cascade {
  232.             set sub [option get $menu m_$e {}]
  233.             if {[string length $sub] != 0} {
  234.             set submenu [Widget_CascadeMenuItem $menu $l $c $sub]
  235.             ButtonMenuInner $submenu [expr $level+1]
  236.             }
  237.         }
  238.         separator {Widget_AddMenuSeparator $menu}
  239.         }
  240.     }
  241.     }
  242.     return $menu
  243. }
  244.